home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / a_utils / perl / mac-perl / mcprl402.bin / Perl_src / stab.c < prev    next >
Text File  |  1992-09-27  |  24KB  |  1,055 lines
  1. /* $RCSfile: stab.c,v $$Revision: 4.0.1.4 $$Date: 92/06/08 15:32:19 $
  2.  *
  3.  *    Copyright (c) 1991, Larry Wall
  4.  *
  5.  *    You may distribute under the terms of either the GNU General Public
  6.  *    License or the Artistic License, as specified in the README file.
  7.  *
  8.  * $Log:    stab.c,v $
  9.  * Revision 4.0.1.4  92/06/08  15:32:19  lwall
  10.  * patch20: fixed confusion between a *var's real name and its effective name
  11.  * patch20: the debugger now warns you on lines that can't set a breakpoint
  12.  * patch20: the debugger made perl forget the last pattern used by //
  13.  * patch20: paragraph mode now skips extra newlines automatically
  14.  * patch20: ($<,$>) = ... didn't work on some architectures
  15.  * 
  16.  * Revision 4.0.1.3  91/11/05  18:35:33  lwall
  17.  * patch11: length($x) was sometimes wrong for numeric $x
  18.  * patch11: perl now issues warning if $SIG{'ALARM'} is referenced
  19.  * patch11: *foo = undef coredumped
  20.  * patch11: solitary subroutine references no longer trigger typo warnings
  21.  * patch11: local(*FILEHANDLE) had a memory leak
  22.  * 
  23.  * Revision 4.0.1.2  91/06/07  11:55:53  lwall
  24.  * patch4: new copyright notice
  25.  * patch4: added $^P variable to control calling of perldb routines
  26.  * patch4: added $^F variable to specify maximum system fd, default 2
  27.  * patch4: $` was busted inside s///
  28.  * patch4: default top-of-form format is now FILEHANDLE_TOP
  29.  * patch4: length($`), length($&), length($') now optimized to avoid string copy
  30.  * patch4: $^D |= 1024 now does syntax tree dump at run-time
  31.  * 
  32.  * Revision 4.0.1.1  91/04/12  09:10:24  lwall
  33.  * patch1: Configure now differentiates getgroups() type from getgid() type
  34.  * patch1: you may now use "die" and "caller" in a signal handler
  35.  * 
  36.  * Revision 4.0  91/03/20  01:39:41  lwall
  37.  * 4.0 baseline.
  38.  * 
  39.  */
  40.  
  41. #include "EXTERN.h"
  42. #include "perl.h"
  43.  
  44. #if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
  45. #include <signal.h>
  46. #endif
  47.  
  48. static char *sig_name[] = {
  49.     SIG_NAME,0
  50. };
  51.  
  52. #ifdef VOIDSIG
  53. #define handlertype void
  54. #else
  55. #define handlertype int
  56. #endif
  57.  
  58. static handlertype sighandler();
  59.  
  60. static int origalen = 0;
  61.  
  62. STR *
  63. stab_str(str)
  64. STR *str;
  65. {
  66.     STAB *stab = str->str_u.str_stab;
  67.     register int paren;
  68.     register char *s;
  69.     register int i;
  70.  
  71.     if (str->str_rare)
  72.     return stab_val(stab);
  73.  
  74.     switch (*stab->str_magic->str_ptr) {
  75.     case '\004':        /* ^D */
  76. #ifdef DEBUGGING
  77.     str_numset(stab_val(stab),(double)(debug & 32767));
  78. #endif
  79.     break;
  80.     case '\006':        /* ^F */
  81.     str_numset(stab_val(stab),(double)maxsysfd);
  82.     break;
  83.     case '\t':            /* ^I */
  84.     if (inplace)
  85.         str_set(stab_val(stab), inplace);
  86.     else
  87.         str_sset(stab_val(stab),&str_undef);
  88.     break;
  89.     case '\020':        /* ^P */
  90.     str_numset(stab_val(stab),(double)perldb);
  91.     break;
  92.     case '\024':        /* ^T */
  93.     str_numset(stab_val(stab),(double)basetime);
  94.     break;
  95.     case '\027':        /* ^W */
  96.     str_numset(stab_val(stab),(double)dowarn);
  97.     break;
  98.     case '1': case '2': case '3': case '4':
  99.     case '5': case '6': case '7': case '8': case '9': case '&':
  100.     if (curspat) {
  101.         paren = atoi(stab_ename(stab));
  102.       getparen:
  103.         if (curspat->spat_regexp &&
  104.           paren <= curspat->spat_regexp->nparens &&
  105.           (s = curspat->spat_regexp->startp[paren]) ) {
  106.         i = curspat->spat_regexp->endp[paren] - s;
  107.         if (i >= 0)
  108.             str_nset(stab_val(stab),s,i);
  109.         else
  110.             str_sset(stab_val(stab),&str_undef);
  111.         }
  112.         else
  113.         str_sset(stab_val(stab),&str_undef);
  114.     }
  115.     break;
  116.     case '+':
  117.     if (curspat) {
  118.         paren = curspat->spat_regexp->lastparen;
  119.         goto getparen;
  120.     }
  121.     break;
  122.     case '`':
  123.     if (curspat) {
  124.         if (curspat->spat_regexp &&
  125.           (s = curspat->spat_regexp->subbeg) ) {
  126.         i = curspat->spat_regexp->startp[0] - s;
  127.         if (i >= 0)
  128.             str_nset(stab_val(stab),s,i);
  129.         else
  130.             str_nset(stab_val(stab),"",0);
  131.         }
  132.         else
  133.         str_nset(stab_val(stab),"",0);
  134.     }
  135.     break;
  136.     case '\'':
  137.     if (curspat) {
  138.         if (curspat->spat_regexp &&
  139.           (s = curspat->spat_regexp->endp[0]) ) {
  140.         str_nset(stab_val(stab),s, curspat->spat_regexp->subend - s);
  141.         }
  142.         else
  143.         str_nset(stab_val(stab),"",0);
  144.     }
  145.     break;
  146.     case '.':
  147. #ifndef lint
  148.     if (last_in_stab && stab_io(last_in_stab)) {
  149.         str_numset(stab_val(stab),(double)stab_io(last_in_stab)->lines);
  150.     }
  151. #endif
  152.     break;
  153.     case '?':
  154.     str_numset(stab_val(stab),(double)statusvalue);
  155.     break;
  156.     case '^':
  157.     s = stab_io(curoutstab)->top_name;
  158.     if (s)
  159.         str_set(stab_val(stab),s);
  160.     else {
  161.         str_set(stab_val(stab),stab_ename(curoutstab));
  162.         str_cat(stab_val(stab),"_TOP");
  163.     }
  164.     break;
  165.     case '~':
  166.     s = stab_io(curoutstab)->fmt_name;
  167.     if (!s)
  168.         s = stab_ename(curoutstab);
  169.     str_set(stab_val(stab),s);
  170.     break;
  171. #ifndef lint
  172.     case '=':
  173.     str_numset(stab_val(stab),(double)stab_io(curoutstab)->page_len);
  174.     break;
  175.     case '-':
  176.     str_numset(stab_val(stab),(double)stab_io(curoutstab)->lines_left);
  177.     break;
  178.     case '%':
  179.     str_numset(stab_val(stab),(double)stab_io(curoutstab)->page);
  180.     break;
  181. #endif
  182.     case ':':
  183.     break;
  184.     case '/':
  185.     break;
  186.     case '[':
  187.     str_numset(stab_val(stab),(double)arybase);
  188.     break;
  189.     case '|':
  190.     if (!stab_io(curoutstab))
  191.         stab_io(curoutstab) = stio_new();
  192.     str_numset(stab_val(stab),
  193.        (double)((stab_io(curoutstab)->flags & IOF_FLUSH) != 0) );
  194.     break;
  195.     case ',':
  196.     str_nset(stab_val(stab),ofs,ofslen);
  197.     break;
  198.     case '\\':
  199.     str_nset(stab_val(stab),ors,orslen);
  200.     break;
  201.     case '#':
  202.     str_set(stab_val(stab),ofmt);
  203.     break;
  204.     case '!':
  205.     str_numset(stab_val(stab), (double)errno);
  206.     str_set(stab_val(stab), errno ? strerror(errno) : "");
  207.     stab_val(stab)->str_nok = 1;    /* what a wonderful hack! */
  208.     break;
  209.     case '<':
  210.     str_numset(stab_val(stab),(double)uid);
  211.     break;
  212.     case '>':
  213.     str_numset(stab_val(stab),(double)euid);
  214.     break;
  215.     case '(':
  216.     s = buf;
  217.     (void)sprintf(s,"%d",(int)gid);
  218.     goto add_groups;
  219.     case ')':
  220.     s = buf;
  221.     (void)sprintf(s,"%d",(int)egid);
  222.       add_groups:
  223.     while (*s) s++;
  224. #ifdef HAS_GETGROUPS
  225. #ifndef NGROUPS
  226. #define NGROUPS 32
  227. #endif
  228.     {
  229.         GROUPSTYPE gary[NGROUPS];
  230.  
  231.         i = getgroups(NGROUPS,gary);
  232.         while (--i >= 0) {
  233.         (void)sprintf(s," %ld", (long)gary[i]);
  234.         while (*s) s++;
  235.         }
  236.     }
  237. #endif
  238.     str_set(stab_val(stab),buf);
  239.     break;
  240.     case '*':
  241.     break;
  242.     case '0':
  243.     break;
  244.     default:
  245.     {
  246.         struct ufuncs *uf = (struct ufuncs *)str->str_ptr;
  247.  
  248.         if (uf && uf->uf_val)
  249.         (*uf->uf_val)(uf->uf_index, stab_val(stab));
  250.     }
  251.     break;
  252.     }
  253.     return stab_val(stab);
  254. }
  255.  
  256. STRLEN
  257. stab_len(str)
  258. STR *str;
  259. {
  260.     STAB *stab = str->str_u.str_stab;
  261.     int paren;
  262.     int i;
  263.     char *s;
  264.  
  265.     if (str->str_rare)
  266.     return str_len(stab_val(stab));
  267.  
  268.     switch (*stab->str_magic->str_ptr) {
  269.     case '1': case '2': case '3': case '4':
  270.     case '5': case '6': case '7': case '8': case '9': case '&':
  271.     if (curspat) {
  272.         paren = atoi(stab_ename(stab));
  273.       getparen:
  274.         if (curspat->spat_regexp &&
  275.           paren <= curspat->spat_regexp->nparens &&
  276.           (s = curspat->spat_regexp->startp[paren]) ) {
  277.         i = curspat->spat_regexp->endp[paren] - s;
  278.         if (i >= 0)
  279.             return i;
  280.         else
  281.             return 0;
  282.         }
  283.         else
  284.         return 0;
  285.     }
  286.     break;
  287.     case '+':
  288.     if (curspat) {
  289.         paren = curspat->spat_regexp->lastparen;
  290.         goto getparen;
  291.     }
  292.     break;
  293.     case '`':
  294.     if (curspat) {
  295.         if (curspat->spat_regexp &&
  296.           (s = curspat->spat_regexp->subbeg) ) {
  297.         i = curspat->spat_regexp->startp[0] - s;
  298.         if (i >= 0)
  299.             return i;
  300.         else
  301.             return 0;
  302.         }
  303.         else
  304.         return 0;
  305.     }
  306.     break;
  307.     case '\'':
  308.     if (curspat) {
  309.         if (curspat->spat_regexp &&
  310.           (s = curspat->spat_regexp->endp[0]) ) {
  311.         return (STRLEN) (curspat->spat_regexp->subend - s);
  312.         }
  313.         else
  314.         return 0;
  315.     }
  316.     break;
  317.     case ',':
  318.     return (STRLEN)ofslen;
  319.     case '\\':
  320.     return (STRLEN)orslen;
  321.     default:
  322.     return str_len(stab_str(str));
  323.     }
  324. }
  325.  
  326. void
  327. stabset(mstr,str)
  328. register STR *mstr;
  329. STR *str;
  330. {
  331.     STAB *stab;
  332.     register char *s;
  333.     int i;
  334.  
  335.     switch (mstr->str_rare) {
  336.     case 'E':
  337.     my_setenv(mstr->str_ptr,str_get(str));
  338.                 /* And you'll never guess what the dog had */
  339.                 /*   in its mouth... */
  340. #ifdef TAINT
  341.     if (strEQ(mstr->str_ptr,"PATH")) {
  342.         char *strend = str->str_ptr + str->str_cur;
  343.  
  344.         s = str->str_ptr;
  345.         while (s < strend) {
  346.         s = cpytill(tokenbuf,s,strend,':',&i);
  347.         s++;
  348.         if (*tokenbuf != '/'
  349.           || (stat(tokenbuf,&statbuf) && (statbuf.st_mode & 2)) )
  350.             str->str_tainted = 2;
  351.         }
  352.     }
  353. #endif
  354.     break;
  355.     case 'S':
  356.     s = str_get(str);
  357.     i = whichsig(mstr->str_ptr);    /* ...no, a brick */
  358.     if (!i && (dowarn || strEQ(mstr->str_ptr,"ALARM")))
  359.         warn("No such signal: SIG%s", mstr->str_ptr);
  360.     if (strEQ(s,"IGNORE"))
  361. #ifndef lint
  362.         (void)signal(i,SIG_IGN);
  363. #else
  364.         ;
  365. #endif
  366.     else if (strEQ(s,"DEFAULT") || !*s)
  367.         (void)signal(i,SIG_DFL);
  368.     else {
  369.         (void)signal(i,sighandler);
  370.         if (!index(s,'\'')) {
  371.         sprintf(tokenbuf, "main'%s",s);
  372.         str_set(str,tokenbuf);
  373.         }
  374.     }
  375.     break;
  376. #ifdef SOME_DBM
  377.     case 'D':
  378.     stab = mstr->str_u.str_stab;
  379.     hdbmstore(stab_hash(stab),mstr->str_ptr,mstr->str_cur,str);
  380.     break;
  381. #endif
  382.     case 'L':
  383.     {
  384.         CMD *cmd;
  385.  
  386.         stab = mstr->str_u.str_stab;
  387.         i = str_true(str);
  388.         str = afetch(stab_xarray(stab),atoi(mstr->str_ptr), FALSE);
  389.         if (str->str_magic && (cmd = str->str_magic->str_u.str_cmd)) {
  390.         cmd->c_flags &= ~CF_OPTIMIZE;
  391.         cmd->c_flags |= i? CFT_D1 : CFT_D0;
  392.         }
  393.         else
  394.         warn("Can't break at that line\n");
  395.     }
  396.     break;
  397.     case '#':
  398.     stab = mstr->str_u.str_stab;
  399.     afill(stab_array(stab), (int)str_gnum(str) - arybase);
  400.     break;
  401.     case 'X':    /* merely a copy of a * string */
  402.     break;
  403.     case '*':
  404.     s = str->str_pok ? str_get(str) : "";
  405.     if (strNE(s,"StB") || str->str_cur != sizeof(STBP)) {
  406.         stab = mstr->str_u.str_stab;
  407.         if (!*s) {
  408.         STBP *stbp;
  409.  
  410.         /*SUPPRESS 701*/
  411.         (void)savenostab(stab);    /* schedule a free of this stab */
  412.         if (stab->str_len)
  413.             Safefree(stab->str_ptr);
  414.         Newz(601,stbp, 1, STBP);
  415.         stab->str_ptr = stbp;
  416.         stab->str_len = stab->str_cur = sizeof(STBP);
  417.         stab->str_pok = 1;
  418.         strcpy(stab_magic(stab),"StB");
  419.         stab_val(stab) = Str_new(70,0);
  420.         stab_line(stab) = curcmd->c_line;
  421.         stab_estab(stab) = stab;
  422.         }
  423.         else {
  424.         stab = stabent(s,TRUE);
  425.         if (!stab_xarray(stab))
  426.             aadd(stab);
  427.         if (!stab_xhash(stab))
  428.             hadd(stab);
  429.         if (!stab_io(stab))
  430.             stab_io(stab) = stio_new();
  431.         }
  432.         str_sset(str, (STR*) stab);
  433.     }
  434.     break;
  435.     case 's': {
  436.         struct lstring *lstr = (struct lstring*)str;
  437.         char *tmps;
  438.  
  439.         mstr->str_rare = 0;
  440.         str->str_magic = Nullstr;
  441.         tmps = str_get(str);
  442.         str_insert(mstr,lstr->lstr_offset,lstr->lstr_len,
  443.           tmps,str->str_cur);
  444.     }
  445.     break;
  446.  
  447.     case 'v':
  448.     do_vecset(mstr,str);
  449.     break;
  450.  
  451.     case 0:
  452.     /*SUPPRESS 560*/
  453.     if (!(stab = mstr->str_u.str_stab))
  454.         break;
  455.     switch (*stab->str_magic->str_ptr) {
  456.     case '\004':    /* ^D */
  457. #ifdef DEBUGGING
  458.         debug = (int)(str_gnum(str)) | 32768;
  459.         if (debug & 1024)
  460.         dump_all();
  461. #endif
  462.         break;
  463.     case '\006':    /* ^F */
  464.         maxsysfd = (int)str_gnum(str);
  465.         break;
  466.     case '\t':    /* ^I */
  467.         if (inplace)
  468.         Safefree(inplace);
  469.         if (str->str_pok || str->str_nok)
  470.         inplace = savestr(str_get(str));
  471.         else
  472.         inplace = Nullch;
  473.         break;
  474.     case '\020':    /* ^P */
  475.         i = (int)str_gnum(str);
  476.         if (i != perldb) {
  477.         static SPAT *oldlastspat;
  478.  
  479.         if (perldb)
  480.             oldlastspat = lastspat;
  481.         else
  482.             lastspat = oldlastspat;
  483.         }
  484.         perldb = i;
  485.         break;
  486.     case '\024':    /* ^T */
  487.         basetime = (time_t)str_gnum(str);
  488.         break;
  489.     case '\027':    /* ^W */
  490.         dowarn = (bool)str_gnum(str);
  491.         break;
  492.     case '.':
  493.         if (localizing)
  494.         savesptr((STR**)&last_in_stab);
  495.         break;
  496.     case '^':
  497.         Safefree(stab_io(curoutstab)->top_name);
  498.         stab_io(curoutstab)->top_name = s = savestr(str_get(str));
  499.         stab_io(curoutstab)->top_stab = stabent(s,TRUE);
  500.         break;
  501.     case '~':
  502.         Safefree(stab_io(curoutstab)->fmt_name);
  503.         stab_io(curoutstab)->fmt_name = s = savestr(str_get(str));
  504.         stab_io(curoutstab)->fmt_stab = stabent(s,TRUE);
  505.         break;
  506.     case '=':
  507.         stab_io(curoutstab)->page_len = (long)str_gnum(str);
  508.         break;
  509.     case '-':
  510.         stab_io(curoutstab)->lines_left = (long)str_gnum(str);
  511.         if (stab_io(curoutstab)->lines_left < 0L)
  512.         stab_io(curoutstab)->lines_left = 0L;
  513.         break;
  514.     case '%':
  515.         stab_io(curoutstab)->page = (long)str_gnum(str);
  516.         break;
  517.     case '|':
  518.         if (!stab_io(curoutstab))
  519.         stab_io(curoutstab) = stio_new();
  520.         stab_io(curoutstab)->flags &= ~IOF_FLUSH;
  521.         if (str_gnum(str) != 0.0) {
  522.         stab_io(curoutstab)->flags |= IOF_FLUSH;
  523.         }
  524.         break;
  525.     case '*':
  526.         i = (int)str_gnum(str);
  527.         multiline = (i != 0);
  528.         break;
  529.     case '/':
  530.         if (str->str_pok) {
  531.         rs = str_get(str);
  532.         rslen = str->str_cur;
  533.         if (rspara = !rslen) {
  534.             rs = "\n\n";
  535.             rslen = 2;
  536.         }
  537.         rschar = rs[rslen - 1];
  538.         }
  539.         else {
  540.         rschar = 0777;    /* fake a non-existent char */
  541.         rslen = 1;
  542.         }
  543.         break;
  544.     case '\\':
  545.         if (ors)
  546.         Safefree(ors);
  547.         ors = savestr(str_get(str));
  548.         orslen = str->str_cur;
  549.         break;
  550.     case ',':
  551.         if (ofs)
  552.         Safefree(ofs);
  553.         ofs = savestr(str_get(str));
  554.         ofslen = str->str_cur;
  555.         break;
  556.     case '#':
  557.         if (ofmt)
  558.         Safefree(ofmt);
  559.         ofmt = savestr(str_get(str));
  560.         break;
  561.     case '[':
  562.         arybase = (int)str_gnum(str);
  563.         break;
  564.     case '?':
  565.         statusvalue = U_S(str_gnum(str));
  566.         break;
  567.     case '!':
  568.         errno = (int)str_gnum(str);        /* will anyone ever use this? */
  569.         break;
  570.     case '<':
  571.         uid = (int)str_gnum(str);
  572.         if (delaymagic) {
  573.         delaymagic |= DM_RUID;
  574.         break;                /* don't do magic till later */
  575.         }
  576. #ifdef HAS_SETRUID
  577.         (void)setruid((UIDTYPE)uid);
  578. #else
  579. #ifdef HAS_SETREUID
  580.         (void)setreuid((UIDTYPE)uid, (UIDTYPE)-1);
  581. #else
  582.         if (uid == euid)        /* special case $< = $> */
  583.         (void)setuid(uid);
  584.         else
  585.         fatal("setruid() not implemented");
  586. #endif
  587. #endif
  588.         uid = (int)getuid();
  589.         break;
  590.     case '>':
  591.         euid = (int)str_gnum(str);
  592.         if (delaymagic) {
  593.         delaymagic |= DM_EUID;
  594.         break;                /* don't do magic till later */
  595.         }
  596. #ifdef HAS_SETEUID
  597.         (void)seteuid((UIDTYPE)euid);
  598. #else
  599. #ifdef HAS_SETREUID
  600.         (void)setreuid((UIDTYPE)-1, (UIDTYPE)euid);
  601. #else
  602.         if (euid == uid)        /* special case $> = $< */
  603.         setuid(euid);
  604.         else
  605.         fatal("seteuid() not implemented");
  606. #endif
  607. #endif
  608.         euid = (int)geteuid();
  609.         break;
  610.     case '(':
  611.         gid = (int)str_gnum(str);
  612.         if (delaymagic) {
  613.         delaymagic |= DM_RGID;
  614.         break;                /* don't do magic till later */
  615.         }
  616. #ifdef HAS_SETRGID
  617.         (void)setrgid((GIDTYPE)gid);
  618. #else
  619. #ifdef HAS_SETREGID
  620.         (void)setregid((GIDTYPE)gid, (GIDTYPE)-1);
  621. #else
  622.         if (gid == egid)            /* special case $( = $) */
  623.         (void)setgid(gid);
  624.         else
  625.         fatal("setrgid() not implemented");
  626. #endif
  627. #endif
  628.         gid = (int)getgid();
  629.         break;
  630.     case ')':
  631.         egid = (int)str_gnum(str);
  632.         if (delaymagic) {
  633.         delaymagic |= DM_EGID;
  634.         break;                /* don't do magic till later */
  635.         }
  636. #ifdef HAS_SETEGID
  637.         (void)setegid((GIDTYPE)egid);
  638. #else
  639. #ifdef HAS_SETREGID
  640.         (void)setregid((GIDTYPE)-1, (GIDTYPE)egid);
  641. #else
  642.         if (egid == gid)            /* special case $) = $( */
  643.         (void)setgid(egid);
  644.         else
  645.         fatal("setegid() not implemented");
  646. #endif
  647. #endif
  648.         egid = (int)getegid();
  649.         break;
  650.     case ':':
  651.         chopset = str_get(str);
  652.         break;
  653.     case '0':
  654.         if (!origalen) {
  655.         s = origargv[0];
  656.         s += strlen(s);
  657.         /* See if all the arguments are contiguous in memory */
  658.         for (i = 1; i < origargc; i++) {
  659.             if (origargv[i] == s + 1)
  660.             s += strlen(++s);    /* this one is ok too */
  661.         }
  662.         if (origenviron[0] == s + 1) {    /* can grab env area too? */
  663.             my_setenv("NoNeSuCh", Nullch);
  664.                         /* force copy of environment */
  665.             for (i = 0; origenviron[i]; i++)
  666.             if (origenviron[i] == s + 1)
  667.                 s += strlen(++s);
  668.         }
  669.         origalen = s - origargv[0];
  670.         }
  671.         s = str_get(str);
  672.         i = str->str_cur;
  673.         if (i >= origalen) {
  674.         i = origalen;
  675.         str->str_cur = i;
  676.         str->str_ptr[i] = '\0';
  677.         Copy(s, origargv[0], i, char);
  678.         }
  679.         else {
  680.         Copy(s, origargv[0], i, char);
  681.         s = origargv[0]+i;
  682.         *s++ = '\0';
  683.         while (++i < origalen)
  684.             *s++ = ' ';
  685.         }
  686.         break;
  687.     default:
  688.         {
  689.         struct ufuncs *uf = (struct ufuncs *)str->str_magic->str_ptr;
  690.  
  691.         if (uf && uf->uf_set)
  692.             (*uf->uf_set)(uf->uf_index, str);
  693.         }
  694.         break;
  695.     }
  696.     break;
  697.     }
  698. }
  699.  
  700. int
  701. whichsig(sig)
  702. char *sig;
  703. {
  704.     register char **sigv;
  705.  
  706.     for (sigv = sig_name+1; *sigv; sigv++)
  707.     if (strEQ(sig,*sigv))
  708.         return sigv - sig_name;
  709. #ifdef SIGCLD
  710.     if (strEQ(sig,"CHLD"))
  711.     return SIGCLD;
  712. #endif
  713. #ifdef SIGCHLD
  714.     if (strEQ(sig,"CLD"))
  715.     return SIGCHLD;
  716. #endif
  717.     return 0;
  718. }
  719.  
  720. static handlertype
  721. sighandler(sig)
  722. int sig;
  723. {
  724.     STAB *stab;
  725.     STR *str;
  726.     int oldsave = savestack->ary_fill;
  727.     int oldtmps_base = tmps_base;
  728.     register CSV *csv;
  729.     SUBR *sub;
  730.  
  731. #ifdef OS2        /* or anybody else who requires SIG_ACK */
  732.     signal(sig, SIG_ACK);
  733. #endif
  734.     stab = stabent(
  735.     str_get(hfetch(stab_hash(sigstab),sig_name[sig],strlen(sig_name[sig]),
  736.       TRUE)), TRUE);
  737.     sub = stab_sub(stab);
  738.     if (!sub && *sig_name[sig] == 'C' && instr(sig_name[sig],"LD")) {
  739.     if (sig_name[sig][1] == 'H')
  740.         stab = stabent(str_get(hfetch(stab_hash(sigstab),"CLD",3,TRUE)),
  741.           TRUE);
  742.     else
  743.         stab = stabent(str_get(hfetch(stab_hash(sigstab),"CHLD",4,TRUE)),
  744.           TRUE);
  745.     sub = stab_sub(stab);    /* gag */
  746.     }
  747.     if (!sub) {
  748.     if (dowarn)
  749.         warn("SIG%s handler \"%s\" not defined.\n",
  750.         sig_name[sig], stab_ename(stab) );
  751.     return;
  752.     }
  753.     /*SUPPRESS 701*/
  754.     saveaptr(&stack);
  755.     str = Str_new(15, sizeof(CSV));
  756.     str->str_state = SS_SCSV;
  757.     (void)apush(savestack,str);
  758.     csv = (CSV*)str->str_ptr;
  759.     csv->sub = sub;
  760.     csv->stab = stab;
  761.     csv->curcsv = curcsv;
  762.     csv->curcmd = curcmd;
  763.     csv->depth = sub->depth;
  764.     csv->wantarray = G_SCALAR;
  765.     csv->hasargs = TRUE;
  766.     csv->savearray = stab_xarray(defstab);
  767.     csv->argarray = stab_xarray(defstab) = stack = anew(defstab);
  768.     stack->ary_flags = 0;
  769.     curcsv = csv;
  770.     str = str_mortal(&str_undef);
  771.     str_set(str,sig_name[sig]);
  772.     (void)apush(stab_xarray(defstab),str);
  773.     sub->depth++;
  774.     if (sub->depth >= 2) {    /* save temporaries on recursion? */
  775.     if (sub->depth == 100 && dowarn)
  776.         warn("Deep recursion on subroutine \"%s\"",stab_ename(stab));
  777.     savelist(sub->tosave->ary_array,sub->tosave->ary_fill);
  778.     }
  779.  
  780.     tmps_base = tmps_max;        /* protect our mortal string */
  781.     (void)cmd_exec(sub->cmd,G_SCALAR,0);        /* so do it already */
  782.     tmps_base = oldtmps_base;
  783.  
  784.     restorelist(oldsave);        /* put everything back */
  785. }
  786.  
  787. STAB *
  788. aadd(stab)
  789. register STAB *stab;
  790. {
  791.     if (!stab_xarray(stab))
  792.     stab_xarray(stab) = anew(stab);
  793.     return stab;
  794. }
  795.  
  796. STAB *
  797. hadd(stab)
  798. register STAB *stab;
  799. {
  800.     if (!stab_xhash(stab))
  801.     stab_xhash(stab) = hnew(COEFFSIZE);
  802.     return stab;
  803. }
  804.  
  805. STAB *
  806. fstab(name)
  807. char *name;
  808. {
  809.     char tmpbuf[1200];
  810.     STAB *stab;
  811.  
  812.     sprintf(tmpbuf,"'_<%s", name);
  813.     stab = stabent(tmpbuf, TRUE);
  814.     str_set(stab_val(stab), name);
  815.     if (perldb)
  816.     (void)hadd(aadd(stab));
  817.     return stab;
  818. }
  819.  
  820. STAB *
  821. stabent(name,add)
  822. register char *name;
  823. int add;
  824. {
  825.     register STAB *stab;
  826.     register STBP *stbp;
  827.     int len;
  828.     register char *namend;
  829.     HASH *stash;
  830.     char *sawquote = Nullch;
  831.     char *prevquote = Nullch;
  832.     bool global = FALSE;
  833.  
  834.     if (isUPPER(*name)) {
  835.     if (*name > 'I') {
  836.         if (*name == 'S' && (
  837.           strEQ(name, "SIG") ||
  838.           strEQ(name, "STDIN") ||
  839.           strEQ(name, "STDOUT") ||
  840.           strEQ(name, "STDERR") ))
  841.         global = TRUE;
  842.     }
  843.     else if (*name > 'E') {
  844.         if (*name == 'I' && strEQ(name, "INC"))
  845.         global = TRUE;
  846.     }
  847.     else if (*name > 'A') {
  848.         if (*name == 'E' && strEQ(name, "ENV"))
  849.         global = TRUE;
  850.     }
  851.     else if (*name == 'A' && (
  852.       strEQ(name, "ARGV") ||
  853.       strEQ(name, "ARGVOUT") ))
  854.         global = TRUE;
  855.     }
  856.     for (namend = name; *namend; namend++) {
  857.     if (*namend == '\'' && namend[1])
  858.         prevquote = sawquote, sawquote = namend;
  859.     }
  860.     if (sawquote == name && name[1]) {
  861.     stash = defstash;
  862.     sawquote = Nullch;
  863.     name++;
  864.     }
  865.     else if (!isALPHA(*name) || global)
  866.     stash = defstash;
  867.     else if ((CMD*)curcmd == &compiling)
  868.     stash = curstash;
  869.     else
  870.     stash = curcmd->c_stash;
  871.     if (sawquote) {
  872.     char tmpbuf[256];
  873.     char *s, *d;
  874.  
  875.     *sawquote = '\0';
  876.     /*SUPPRESS 560*/
  877.     if (s = prevquote) {
  878.         strncpy(tmpbuf,name,s-name+1);
  879.         d = tmpbuf+(s-name+1);
  880.         *d++ = '_';
  881.         strcpy(d,s+1);
  882.     }
  883.     else {
  884.         *tmpbuf = '_';
  885.         strcpy(tmpbuf+1,name);
  886.     }
  887.     stab = stabent(tmpbuf,TRUE);
  888.     if (!(stash = stab_xhash(stab)))
  889.         stash = stab_xhash(stab) = hnew(0);
  890.     if (!stash->tbl_name)
  891.         stash->tbl_name = savestr(name);
  892.     name = sawquote+1;
  893.     *sawquote = '\'';
  894.     }
  895.     len = namend - name;
  896.     stab = (STAB*)hfetch(stash,name,len,add);
  897.     if (stab == (STAB*)&str_undef)
  898.     return Nullstab;
  899.     if (stab->str_pok) {
  900.     stab->str_pok |= SP_MULTI;
  901.     return stab;
  902.     }
  903.     else {
  904.     if (stab->str_len)
  905.         Safefree(stab->str_ptr);
  906.     Newz(602,stbp, 1, STBP);
  907.     stab->str_ptr = stbp;
  908.     stab->str_len = stab->str_cur = sizeof(STBP);
  909.     stab->str_pok = 1;
  910.     strcpy(stab_magic(stab),"StB");
  911.     stab_val(stab) = Str_new(72,0);
  912.     stab_line(stab) = curcmd->c_line;
  913.     stab_estab(stab) = stab;
  914.     str_magic((STR*)stab, stab, '*', name, len);
  915.     stab_stash(stab) = stash;
  916.     if (isDIGIT(*name) && *name != '0') {
  917.         stab_flags(stab) = SF_VMAGIC;
  918.         str_magic(stab_val(stab), stab, 0, Nullch, 0);
  919.     }
  920.     if (add & 2)
  921.         stab->str_pok |= SP_MULTI;
  922.     return stab;
  923.     }
  924. }
  925.  
  926. void
  927. stab_fullname(str,stab)
  928. STR *str;
  929. STAB *stab;
  930. {
  931.     HASH *tb = stab_stash(stab);
  932.  
  933.     if (!tb)
  934.     return;
  935.     str_set(str,tb->tbl_name);
  936.     str_ncat(str,"'", 1);
  937.     str_scat(str,stab->str_magic);
  938. }
  939.  
  940. void
  941. stab_efullname(str,stab)
  942. STR *str;
  943. STAB *stab;
  944. {
  945.     HASH *tb = stab_estash(stab);
  946.  
  947.     if (!tb)
  948.     return;
  949.     str_set(str,tb->tbl_name);
  950.     str_ncat(str,"'", 1);
  951.     str_scat(str,stab_estab(stab)->str_magic);
  952. }
  953.  
  954. STIO *
  955. stio_new()
  956. {
  957.     STIO *stio;
  958.  
  959.     Newz(603,stio,1,STIO);
  960.     stio->page_len = 60;
  961.     return stio;
  962. }
  963.  
  964. void
  965. stab_check(min,max)
  966. int min;
  967. register int max;
  968. {
  969.     register HENT *entry;
  970.     register int i;
  971.     register STAB *stab;
  972.  
  973.     for (i = min; i <= max; i++) {
  974.     for (entry = defstash->tbl_array[i]; entry; entry = entry->hent_next) {
  975.         stab = (STAB*)entry->hent_val;
  976.         if (stab->str_pok & SP_MULTI)
  977.         continue;
  978.         curcmd->c_line = stab_line(stab);
  979.         warn("Possible typo: \"%s\"", stab_name(stab));
  980.     }
  981.     }
  982. }
  983.  
  984. static int gensym = 0;
  985.  
  986. STAB *
  987. genstab()
  988. {
  989.     (void)sprintf(tokenbuf,"_GEN_%d",gensym++);
  990.     return stabent(tokenbuf,TRUE);
  991. }
  992.  
  993. /* hopefully this is only called on local symbol table entries */
  994.  
  995. void
  996. stab_clear(stab)
  997. register STAB *stab;
  998. {
  999.     STIO *stio;
  1000.     SUBR *sub;
  1001.  
  1002.     if (!stab || !stab->str_ptr)
  1003.     return;
  1004.     afree(stab_xarray(stab));
  1005.     stab_xarray(stab) = Null(ARRAY*);
  1006. #ifndef macintosh
  1007.     (void)hfree(stab_xhash(stab), FALSE);
  1008. #else
  1009.     hfree(stab_xhash(stab), FALSE);
  1010. #endif
  1011.     stab_xhash(stab) = Null(HASH*);
  1012.     str_free(stab_val(stab));
  1013.     stab_val(stab) = Nullstr;
  1014.     /*SUPPRESS 560*/
  1015.     if (stio = stab_io(stab)) {
  1016.     do_close(stab,FALSE);
  1017.     Safefree(stio->top_name);
  1018.     Safefree(stio->fmt_name);
  1019.     Safefree(stio);
  1020.     }
  1021.     /*SUPPRESS 560*/
  1022.     if (sub = stab_sub(stab)) {
  1023.     afree(sub->tosave);
  1024.     cmd_free(sub->cmd);
  1025.     }
  1026.     Safefree(stab->str_ptr);
  1027.     stab->str_ptr = Null(STBP*);
  1028.     stab->str_len = 0;
  1029.     stab->str_cur = 0;
  1030. }
  1031.  
  1032. #if defined(CRIPPLED_CC) && (defined(iAPX286) || defined(M_I286) || defined(I80286))
  1033. #define MICROPORT
  1034. #endif
  1035.  
  1036. #ifdef    MICROPORT    /* Microport 2.4 hack */
  1037. ARRAY *stab_array(stab)
  1038. register STAB *stab;
  1039. {
  1040.     if (((STBP*)(stab->str_ptr))->stbp_array) 
  1041.     return ((STBP*)(stab->str_ptr))->stbp_array;
  1042.     else
  1043.     return ((STBP*)(aadd(stab)->str_ptr))->stbp_array;
  1044. }
  1045.  
  1046. HASH *stab_hash(stab)
  1047. register STAB *stab;
  1048. {
  1049.     if (((STBP*)(stab->str_ptr))->stbp_hash)
  1050.     return ((STBP*)(stab->str_ptr))->stbp_hash;
  1051.     else
  1052.     return ((STBP*)(hadd(stab)->str_ptr))->stbp_hash;
  1053. }
  1054. #endif            /* Microport 2.4 hack */
  1055.